# ************************************************
# DATA CLEANING AND PRE PROCESSING
# ************************************************
# ************************************************
# scrapeWeb() :
# Scraping the data for the games and saving it in a csv file
# INPUT:
# dataframe - games - Table of games
# string - csvFileName - Name of the CSV File
#
# OUTPUT : /
# ************************************************
scrapeWeb<-function(game_web, cssElement){
el <- game_web %>%
html_nodes(xpath = cssElement) %>%
html_text()
return(el)
}
# ************************************************
# scrapeGames() :
# Scraping the data for the games and saving it in a csv file
# INPUT:
# dataframe - games - Table of games
# string - csvFileName - Name of the CSV File
#
# OUTPUT : /
# ************************************************
scrapeGames<-function(games, csvFileName){
#Initial values
scraped_game_data <- data.frame()
counter<-0
total_count<-0
for (row in 1:100){ #nrow(games)
start_time_per_game <- Sys.time()
counter<-counter + 1
# Getting the name of the current game
name <- games[row, ]$Name
name_cp <- name
# Transforming all the spaces in the name to dashes; to make it a link
name <- chartr(" ", "-", name)
# Removing all the other characters, other than the dash; such as periods or commas
# Also changing the upper to lower cases
name <- gsub("[^-a-zA-Z0-9[:space:]]+", "", tolower(name), perl = TRUE)
platform <- games[row, ]$Platform
platform_cp <- platform
platform <- PLATFORMS[platform]
# If URL is valid, then
if(!is.na(platform)){
# Combining the platform and the name, url looks like this -> /{platform}/{game_name}
platform_name<- paste(platform, name, sep="/")
# Fetching the URL and if the call fails it will return NA else it will return the HTML
game_web<-tryCatch(
read_html(paste(METACRITIC_URL, platform_name, sep="")),
error = function(e){NA}
)
# Scraping the values from the web page
if(!is.na(game_web)){
temp_vector <- c()
#Scraping defined xpaths
for(element in XPATH_DICT){
scraped_value = scrapeWeb(game_web, element)
if(!is.na(scraped_value[1])){
temp_vector <- c(temp_vector, scraped_value[1])
}
}
# Extracting the year from the string
year_only <- strsplit(temp_vector[1], ", ")[[1]]
# Saving the values into the dataframe
tmp_game <- data.frame(name_cp, platform_cp, temp_vector[1], year_only[2], temp_vector[2], temp_vector[3])
scraped_game_data <- rbind(scraped_game_data, tmp_game)
}
}
# Saving values to CSV every 10 values
limit = 10
if (identical(counter,limit)){
rw_names = FALSE
#Adding table names on the first save
if(total_count == 0){
rw_names = TRUE
names(scraped_game_data) <- c('Name', 'Platform', 'Release Date', 'Release Year', 'Critic Reviews', 'User Review')
}
total_count<- total_count + counter
write.table(scraped_game_data, file = csv_path, sep = ",",
append = TRUE, quote = TRUE,
col.names = rw_names, row.names = FALSE)
counter<-0
scraped_game_data <- data.frame()
}
}
}
# ************************************************
# unifyNAValues() :
# Replaced values equivalent to NA with NA value
# eg. "N/A" , "tbd" - to be determined, "RP" - rating pending
# INPUT: dataframe - dataset - dataframe to unify NA's on
# OUTPUT : dataframe - dataset - dataframe with unified NA's
# ************************************************
unifyNAValues<-function(dataset){
dataset[dataset == 'N/A'] <- NA
dataset[dataset == 'tbd'] <- NA
dataset[dataset == ''] <- NA
dataset[dataset == 'RP'] <- NA
return (dataset)
}
# ************************************************
# NAValuesSummary() :
# Prints a summary and returns a subset of all rows in dataframe that contain NA values
# INPUT: dataframe - dataset - dataframe to get NA summary for
# OUTPUT : dataframe - NA_dataframe - of all rows that contain NA values
# ************************************************
NAValuesSummary<-function(dataset){
NA_dataframe <- dataset[rowSums(is.na(dataset)) > 0,]
print(paste('Total number of rows with NA values:', nrow(NA_dataframe)))
print('Summary of NA values:')
print(colSums(is.na((NA_dataframe))))
return (NA_dataframe)
}
# ************************************************
# group_regions():
# Searching through different region types (country, continent, sub_continent) and grouping them with the years
# The only requirement is that all the regions need to be excluded from one another
# (as then they are removed from the dataset after being found)
#
# INPUT:
# Dataframe - demo - dataset of age and gender demographics
# boolean - other - adding an other field to the dataset
#
# OUTPUT : summarized_demographics - data grouped by region and year, where the age and gender are summarized as median
# ************************************************
group_regions <- function(demo, other=TRUE){
first<-TRUE
# Iterating through the regions
for(region in REGIONS){
print(region)
# Getting the column name in which the value is located (either country, continent or sub-region)
col_name <- names(which(colSums(demo == region, na.rm = TRUE) > 0))
year<-"Year"
# Grouping the values which belong to the region by the year and the region
group <- group_by_at(demo[demo[col_name] == region, ], vars(year,col_name))
# Removing the region from demographics -> in order to get all the other values
demo<-demo[demo[col_name] != region, ]
# Summarizing the data based on the region and the year, and getting the median of the age and gender demographics
summary<-summarize(group, median(age, na.rm = TRUE), median(Populationfemaleoftotalpopulation, na.rm = TRUE))
# Altering the names of the table
names(summary)<-JOINED_NAMES
# The first table we set to the summarized_demographics, and the rest we bind to the table based on the year
if(first) {
summarized_demographics<-summary
first<-FALSE
} else {
summarized_demographics<-cbind(data.frame(summarized_demographics), summary[-which(names(summary) == "year")])
}
}
if(other){
## Creating a data frame for all the other places
print("Other")
# Summarize
summary<-summarize(group_by(demo, Year), median(age, , na.rm = TRUE), median(Populationfemaleoftotalpopulation, , na.rm = TRUE))
# Create a region column and set it to"Other"
summary$region <- "Other"
# Reorder
summary<-summary %>% select(Year, region, everything())
# Rename
names(summary)<-JOINED_NAMES
# Adding the "Other" columns to the other summaries
summarized_demographics<-cbind(data.frame(summarized_demographics), summary[-which(names(summary) == "year")])
}
# Iterating through the column names to change the column to names, to contain relevant region data
for (i in seq(2, length(summarized_demographics), by=3)) {
colnames(summarized_demographics)[i] = "region"
region<-NPREPROCESSING_removePunctuation(unique(summarized_demographics[[i]]))
colnames(summarized_demographics)[i+1] = paste(region, "ageMedian", sep="_")
colnames(summarized_demographics)[i+2] = paste(region, "femaleRatioMedian", sep="_")
}
summarized_demographics<-summarized_demographics[which(names(summarized_demographics) != "region")]
return(summarized_demographics)
}
# ************************************************
# changeManual_fieldType() :
# Manually changes any field type of a field to the desired one based on a dictionary input
# Possible Field Types:
# SYMBOLIC, NUMERIC ORDINAL, NUMERIC DISCRETE
# INPUT: Vector - field_type_list - list of field types corresponding to the dataset colnames
# Ditctionary - manual_changes - Dictionary of field
# names and corresponding field types they need to be changed to
# DataFrame - dataset - dataset associated to the field types.
# OUTPUT: Vector - field_type_list - list of field types corresponding to the dataset colnames
# ************************************************
changeManual_fieldType<-function(dataset, field_types_list, manual_changes){
# Loop thorugh field_types and assign the correct types from the manual_changes dict
for(i in 1:length(dataset)){
field_name <- colnames(dataset)[i]
if(field_name %in% names(manual_changes)){
field_types_list[i] <- manual_changes[field_name]
}
}
return(field_types_list)
}
# ************************************************
# concatArrayToString() :
# creates a string interpretation of an array, with a comma to separate values
# INPUT: array of values
# OUTPUT : single string containing all values from the array, in order
# ************************************************
concatArrayToString <- function(arr_to_join){
arr_string <- ""
for (item in arr_to_join){
arr_string = paste(arr_string, item, sep = ", ")
}
return (arr_string)
}
# ************************************************
# concatGameName() :
# creates a string interpretation of an array, with a space to separate values
# INPUT: array of values
# OUTPUT : single string containing all values from the array, in order
# ************************************************
concatGameName <- function(arr_to_join){
arr_string <- ""
for (item in arr_to_join){
arr_string = paste(arr_string, item)
}
return (arr_string)
}
# ************************************************
# stringToArray() :
# creates a string representation of an array back to an array
# INPUT: string representation of array (ouput of concatArrayToString())
# OUTPUT : vector containing all values encoded in the string
# ************************************************
stringToArray <- function(input_string){
out_arr <- strsplit(input_string, ", ")
return(out_arr)
}
# ************************************************
# filterUnwantedWords() :
# removes unwanted words from the given vector
# INPUT: game title as a vector of words
# OUTPUT : the game title as a vector with unwanted words removed
# ************************************************
filterUnwantedWords <- function(inut_name_array){
# Words to filter out of game titles
words_to_remove <- c(
"of", "The", "no", "the", "&", "to", "-", "DS", "and", "in", "Edition", "Collection", "/",
"for", "A", "My", "DS:", "a", "In", "on", "or", "at", "For"
)
name_vector <- c()
for (word in inut_name_array){
name_vector <- append(name_vector, word)
}
new_split_name <- name_vector[!name_vector %in% words_to_remove]
return(new_split_name)
}
# ************************************************
# singleWordComparrison() :
# compares given game title to others to find relationships between titles. For 1 word titles
# INPUT:
#- word: first word of the game to compare with
#- game_name: full name of the game (as a vector, seperated on spaces)
#- related_game_array: vector to add the related games to
#- split_game_names: vector of all games to compare against (each name seperated on spaces)
#
# OUTPUT :
#- vector of all related games
# ************************************************
singleWordComparrison <- function(word, filtered_game_name, game_name, related_game_array, split_game_names){
for (split_game in split_game_names){
if (word == (split_game[1])){
if (!identical(game_name, split_game)){
related_game_array <- append(related_game_array, concatGameName(split_game))
}
}
}
return(related_game_array)
}
# ************************************************
# multiWordComparrison() :
# compares given game title to others to find relationships between titles. For titles longer than 1 word
# INPUT:
#- first_word: first word of the game to compare with
#- second_word: first word of the game to compare with, filtered so it is not numeric
#- game_name: full name of the game (as a vector, seperated on spaces)
#- related_game_array: vector to add the related games to
#- split_game_names: vector of all games to compare against (each name seperated on spaces)
#
# OUTPUT :
#- vector of all related games
# ************************************************
multiWordComparrison <- function(first_word, second_word, game_name, filtered_game_name, related_game_array, split_game_names){
for (split_game in split_game_names){
# check 1st word
if (first_word == (split_game[1])){
# check 2nd word
# if 2nd word of split_game is a number than skip it (numbers are filtered out of second_word)
if (grepl("[0-9]", split_game[2])){
if (length(split_game) > 2){
# if split_game is not longer than 2 words and second word is a number, then compare 1st words
if (second_word == (split_game[3])){
if (!identical(game_name, split_game)){
related_game_array <- append(related_game_array, concatGameName(split_game))
}
}
else{
if (!identical(game_name, split_game)){
related_game_array <- append(related_game_array, concatGameName(split_game))
}
}
}
}
else{
if (length(split_game) > 2){
if (second_word == (split_game[2])){
if (!identical(game_name, split_game)){
related_game_array <- append(related_game_array, concatGameName(split_game))
}
}
}
else{
if (!identical(game_name, split_game)){
related_game_array <- append(related_game_array, concatGameName(split_game))
}
}
}
}
}
return(related_game_array)
}
# ************************************************
# CREATE_FRANCHISES() :
# Adds column to dataset that says if a game is part of a franchise
# INPUT: dataframe containing game data
# OUTPUT : data frame including new column
# ************************************************
CREATE_FRANCHISES <- function(game_df){
game_count <- 0
# vector containing all game names from the dataset
game_names <- game_df$Name
#####################################
# Filter our repeated names
# caused by different consoles
#####################################
unique_names <- c()
for (name in game_df$Name){
if (name %in% game_names & !identical(name, "")){
game_names <- game_names[game_names != name]
unique_names <- append(unique_names, name)
game_count <- game_count + 1
}
}
# split each name into an array of words
unique_names_split <- strsplit(unique_names, " ")
# get a vector containing all unique words in the game titles
unique_words <- c()
words <- c()
for (name in unique_names_split){
for (word in name){
if (! word %in% unique_words ){
unique_words <- append(unique_words, word)
}
}
}
# get a vector containing every word (including repeated)
for (name in unique_names_split){
for (word in name){
words <- append(words, word)
}
}
count <- 0
initial_franchises = c()
for (split_name in unique_names_split){
# count is just holding the number of games that are looked at
count <- count + 1
game_array <- c()
new_split_name <- filterUnwantedWords(split_name)
# If game name is 1 word long
if (length(new_split_name) == 1){
first_word <- new_split_name[1]
game_array <- singleWordComparrison(first_word, split_name, new_split_name, game_array, unique_names_split)
game_franchise_string <- concatArrayToString(c(concatGameName(split_name), game_array))
initial_franchises <- append(initial_franchises, game_franchise_string)
}
else {
first_word <- split_name[1]
second_word <- split_name[2]
# check 2nd word to see if it's just numbers
# if it is, then disregard and just use 1st word
if (grepl("[0-9]", second_word)){
game_array <- singleWordComparrison(first_word, split_name, new_split_name, game_array, unique_names_split)
game_franchise_string <- concatArrayToString(c(concatGameName(split_name), game_array))
initial_franchises <- append(initial_franchises, game_franchise_string)
}
else{
game_array <- multiWordComparrison(first_word, second_word, split_name, new_split_name, game_array, unique_names_split)
game_franchise_string <- concatArrayToString(c(concatGameName(split_name), game_array))
initial_franchises <- append(initial_franchises, game_franchise_string)
}
}
}
count <- 0
franchise_games <- c()
in_franchise <- c()
for (franchise in stringToArray(initial_franchises)){
if (length(franchise) > 5){
count <- count + 1
franchise_games <- append(franchise_games, sub(" ", "", franchise[2]))
}
}
count <- 0
game_names <- game_df$Name
for (name in game_names){
count <- count + 1
if (name %in% franchise_games){
in_franchise <- append(in_franchise, 1)
}
else{
in_franchise <- append(in_franchise, 0)
}
}
game_df$inFranchise <- in_franchise
return(game_df)
}
# ************************************************
# alterDataframeNames()
# Update column names based on dictionary of old and new
# column names
#
# INPUT: data frame - df - df with column names
# dictionary - change_dict - old and new column names
#
# OUTPUT : data frame - original dataframe with updated column names
# ************************************************
alterDataframeNames<-function(df, change_dict){
for (old_name in names(change_dict)){
new_name <- change_dict[old_name]
loc <- grep(old_name, colnames(df))
names(df)[loc] <- new_name
}
return(df)
} # endof alterDataframeNames
# ************************************************
# appendToDataframe()
# Append rows to dataframe
#
# INPUT: data frame - df - dataframe
# vector - data - data to be appended to the df
#
# OUTPUT : data frame - dataframe with the newly added row
# ************************************************
appendToDataframe<-function(df, data){
df[nrow(df)+1, ] <- data
return(df)
} # endof appendToDataframe
# ************************************************
# hot_encode()
# If this is our function but it's altered lab code make sure to mention that
#
# INPUT: df - df - dataframe
# vector - columns - columns that have to be one-hot-encoded
#
# OUTPUT : data frame - dataframe with the newly one-hot-encoded columns
# ************************************************
hot_encode <- function(df, columns) {
catagoricalReadyforML<-NPREPROCESSING_categorical(df[,columns])
df <- df %>% select(-one_of(columns))
df_encoded<-cbind(df, catagoricalReadyforML)
return(df_encoded)
}
# ************************************************
# minMaxSummary() :
#
# The min and max values of each numeric column
# This will be used for denormalization
#
# INPUT: dataframe - dataset - dataframe of values
#
# OUTPUT : dataframe - min_max_df - dataframe of all min max values
# for numeric columncs
# ************************************************
minMaxSummary<-function(dataset){
min_max <- list(
min = ~min(.x, na.rm = TRUE),
max = ~max(.x, na.rm = TRUE)
)
min_max_df <- dataset %>%
summarise(across(where(is.numeric), min_max))
return(min_max_df)
}
# ************************************************
# LINEAR REGRESSION
# ************************************************
# ************************************************
# rmse()
# Calculate RMSE of predicted values against actual values
#
# INPUT: actual - list - values from the dataset
# predicted - list - predicted values by a model
#
# OUTPUT : float - RMSE
# ************************************************
rmse<-function(actual,predicted){
# Getting the squared difference between predicted and actual
sqr_diff <- (actual-predicted)^2
# Unlisting it if it is a list
sqr_diff <- verifyType(sqr_diff)
# Return the square-rooted mean of the squared difference - i.e. RMSE
return(sqrt(mean(sqr_diff)))
} #endof rmse
# ************************************************
# mae()
# Calculate MAE of predicted values against actual values
#
# INPUT: actual - list - values from the dataset
# predicted - list - predicted values by a model
#
# OUTPUT : float - MAE
# ************************************************
mae<-function(actual,predicted){
# Getting the difference between predicted and actual values
diff <- (actual-predicted)
# Unlisting it if it is a list
diff <- verifyType(diff)
# Return the mean of absolute difference - i.e. MAE
return(mean(abs(diff)))
}
# ************************************************
# verifyType()
# Verify the type, if the type is a list unlist it
#
# INPUT: list - values - list to unlist
#
# OUTPUT : values - unlisted list
# ************************************************
verifyType <- function(values){
# Check the type of the input
if(typeof(values) == "list"){
# Unlist if it is a list
values <- unlist(values)
}
return(values)
}
# ************************************************
# linearRegressionPlotPredict()
# Train a linear model, plot the regression and calculate metrics
#
# INPUT: dataframe - dataset - train dataset
# dataframe - datasetTest - test dataset
# string - predictorName - name of the independent variable
# string - ouptutName - name of the dependent variable
#
# OUTPUT : values - unlisted list
# ************************************************
linearRegressionPlotPredict <- function(dataset, datasetTest, predictorName, outputName){
# Get the column number of the predictor
predictor_loc <- match(predictorName, names(dataset))
# Group the dataset by the output and then get the mean of the predictor
df <- dataset %>%
group_by_(outputName) %>%
summarize_at(predictor_loc-1, mean)
print(names(df))
# Define the formula for predicting the output
formula <- paste0(outputName,"~",predictorName)
# Change the order of the column
df <- df[, c(2,1)]
# Train the linear model on the train set
modelFit <- lm(formula, data = df)
# Get the predictor input from the test set
predictorInput<-data.frame(datasetTest[,predictorName])
names(predictorInput)<-predictorName
# Get the actual value that we are expecting the model to predict
y_actual<-datasetTest[,outputName]
y_predicted<-predict(modelFit, predictorInput)
# Calculate the metrics based on the actual and predicted values
RMSE<-round(rmse(y_actual,y_predicted),digits=2)
mae<-round(mae(y_actual,y_predicted),digits=2)
r2<-round(Nr2(modelFit),digits=2)
# Plotting the scatter graph
plot(df, main=paste("Linear Regression:",
sub=paste("MAE=",mae,"RMSE=",RMSE," R2=",r2)))
# Graphing the best fit line through the scatter plot based on the linear model
abline(modelFit, col = "red")
} #endof linearRegressionPlotPredict
# ************************************************
# Nr2()
# Calculate the r2 metric (adjusted to allow for multiple inputs)
# REMEMBER this is a measure of the fit of the training data to the model
# it is NOT a measure of how good a predictor the model is on unseen data
# INPUT: object - linearModel - trained linear model
# OUTPUT : double - R2 extracted from the model object
# ************************************************
Nr2<-function(linearModel){
rsq<-summary(linearModel)$adj.r.squared
return(rsq)
} # endof Nr2
# ************************************************
# Calculate the r2 measure
#
# INPUT: vector - double values for actual values
# vector - double values of predicted values
# OUTPUT : double - calculated N2
# ************************************************
Nr2_timeSeries<-function(actual,preds){
rsq<-cor(preds, actual) ^ 2
return(rsq)
}
# ************************************************
# CLUSTERING
# ************************************************
# ************************************************
# splitDataBy() :
#
# Returns a dataframe of all rows that are of a certain genre and platform
#
# INPUT: dataframe - dataset - dataframe to split
# String - splitBy - column name to split data by
# OUTPUT : dataframe - dataset - new dataframe with data belonging to that genre and platform
# ************************************************
splitDataBy<-function(dataset, splitBy){
dataset <- dataset[which(dataset[, splitBy] == 1),]
return(dataset)
}
# ************************************************
# denormalize()
# INPUT: vector - input - vector of inputs to denormalize
# double - min - minimum value
# double - max - maximum value
# OUTPUT : double - denormalized value
# ************************************************
denormalize<-function(input, min, max){
input*(max-min) + min
}
# ************************************************
# denormalizeColumns()
# INPUT: dataframe - dataset - dataframe containing normalized values
# vector - columnList - vector of columnNames to denormalize
# dataframe - minMax - dataframe of mins and maxs of each column before normalization
# OUTPUT : dataframe - dataset - dataframe of denormalized values
# ************************************************
denormalizeColumns<-function(dataset, columnList, minMax) {
for (colName in columnList) {
minCol <- paste(colName, "_min", sep = "")
maxCol <- paste(colName, "_max", sep = "")
dataset[colName] <- mapply(denormalize, dataset[,colName], select(minMax,contains(minCol)), select(minMax,contains(maxCol)))
}
return(dataset)
}
# ************************************************
# determineClusterNum() :
#
# Returns the optimal number of clusters based on the silhouette index
#
# INPUT: predictors - input predictors dataframe for clustering
#
# OUTPUT : numClusters - Optimal number of clusters
# ************************************************
# Uses library(factoextra)
# https://cran.r-project.org/web/packages/factoextra/index.html
# ************************************************
determineClusterNum <- function(predictors){
p<-factoextra::fviz_nbclust(predictors, kmeans, method = "silhouette", k.max = 15)
p<-p$data
numClusters<-as.numeric(p$clusters[which.max(p$y)])
print(paste("Optimal Number of Clusters found Through Silhouette Index:",numClusters))
return(numClusters)
}
# ************************************************
# summaryPercentage():
# Calculates percentage for input field
#
# INPUT: integer - input - occurences out of total
# integer - total - total number of occurences
#
# OUTPUT : double - percentage
# ************************************************
summaryPercentage<-function(input, total) {
return((input/total)*100)
}
# ************************************************
# printClusterProfiles() :
# Prints cluster profiles for passed in cluster model
# INPUT: string - title - title for each cluster profile
# list - clusterModel - list of cluster profiles
# integer - clusterNum - number of clusters
# dataframe - originalDataset - original dataframe to profile clusters on
#
# OUTPUT : prints summary of cluster profiles
# ************************************************
printClusterProfiles<-function(title, clusterModel, clusterNum, originalDataset){
print(paste("Summary for:", title))
print("*******************************************")
for (k in 1:clusterNum){
clusterRecord<-originalDataset[which(clusterModel$cluster==k),]
totalNumOfGames <- nrow(clusterRecord)
inHighSales<-clusterRecord$GlobalSales>0.9
inFranchise<-clusterRecord$inFranchise==1
print(paste("Clus=",k))
print(paste("Total number of games in cluster:", totalNumOfGames))
print(paste("Average Global Sales:", mean(clusterRecord$GlobalSales)))
print("Percentages:")
print(paste("High global sales:", summaryPercentage(sum(inHighSales), totalNumOfGames), "%"))
print(paste("High NA sales:", summaryPercentage(sum(clusterRecord$NASales>0.9), totalNumOfGames), "%"))
print(paste("High JP sales:", summaryPercentage(sum(clusterRecord$JPSales>0.9), totalNumOfGames), "%"))
print(paste("High EU sales:", summaryPercentage(sum(clusterRecord$EUSales>0.9), totalNumOfGames), "%"))
print(paste("High Other sales:", summaryPercentage(sum(clusterRecord$OtherSales>0.9), totalNumOfGames), "%"))
print(paste("Games in franchise with high sales:", summaryPercentage(sum(inHighSales & inFranchise), totalNumOfGames), "%"))
print(paste("Games in franchise:", summaryPercentage(sum(inFranchise), totalNumOfGames), "%"))
print("Percentage of high selling games ratings:")
print(paste("E:", summaryPercentage(sum(clusterRecord$Rating==0.00), totalNumOfGames), "%"))
print(paste("EC:", summaryPercentage(sum(clusterRecord$Rating==0.25), totalNumOfGames), "%"))
print(paste("E10+:", summaryPercentage(sum(clusterRecord$Rating==0.50), totalNumOfGames), "%"))
print(paste("T:", summaryPercentage(sum(clusterRecord$Rating==0.75), totalNumOfGames), "%"))
print(paste("M:", summaryPercentage(sum(clusterRecord$Rating==1.00), totalNumOfGames), "%"))
print("Platform Frequencies of High Sale Games:")
highSalesPlatform <- clusterRecord[which(inHighSales),33:48]
platformCumsum <- cumsum(highSalesPlatform)
platformFreq <- tail(platformCumsum[,which(tail(platformCumsum,1)!= 0)],1)
print(platformFreq)
print("Platform Frequencies")
platform <- clusterRecord[,33:48]
platformCumsum <- cumsum(platform)
platformFreq <- tail(platformCumsum[,which(tail(platformCumsum,1)!= 0)],1)
print(platformFreq)
print("------------------------------------------")
}
}
# ************************************************
# applyKmeans_printPlotAndProfiles() :
# Applies Kmeans clustering and print plot and summary
# INPUT: dataframe - predictors - dataframe of predictors to use for clustering
# integer - clusterNum - number of clusters
# dataframe - originalDataset - original dataframe to profile clusters on
# string - title - title for each cluster profile
#
# ************************************************
# prints plots of clustering and cluster profiles
# ************************************************
# Uses library(factoextra)
# https://cran.r-project.org/web/packages/factoextra/index.html
# ************************************************
applyKmeans_printPlotAndProfiles<-function(predictors, clusterNum, originalDataset, title){
kMeansModel <- kmeans(x=predictors, centers=clusterNum, iter.max = 10, nstart=10)
p<-factoextra::fviz_cluster(kMeansModel, data=predictors,geom = "point") +
labs(title=title)
print(p)
printClusterProfiles(title, kMeansModel, clusterNum, originalDataset)
}
# ************************************************
# applyHierarchical_printPlotAndProfiles() :
# Applies hierarchical clustering and print plot and summary
# INPUT: dataframe - predictors - dataframe of predictors to use for clustering
# integer - clusterNum - number of clusters
# dataframe - originalDataset - original dataframe to profile clusters on
# string - title - title for each cluster profile
# string - xAxis - column to plot on x axis of plot
# string - yAxis - column to plot on y axis of plot
#
# ************************************************
# Prints plots of hierarchical clustering and summary of cluster profiles
# ************************************************
# Uses library(ggplot2)
# https://ggplot2.tidyverse.org/
# ************************************************
applyHierarchical_printPlotAndProfiles<-function(predictors, clusterNum, originalDataset,
title, xAxis, yAxis){
result <- hcut(predictors, k = clusterNum, hc_method = "complete")
cols_to_denormalize <- c('NASales', 'EUSales', 'JPSales', 'OtherSales', 'GlobalSales')
clustering_predictors_real_values <- denormalizeColumns(predictors, cols_to_denormalize, MIN_MAX_SUMMARY)
p<-ggplot(clustering_predictors_real_values, aes(x=(!!as.symbol(xAxis)), y=(!!as.symbol(yAxis)))) +
geom_point(aes(color = factor(result$cluster))) +
labs(title=title) +
theme(aspect.ratio=1) +
scale_colour_discrete("Cluster Num")
print(p)
printClusterProfiles(title, result, clusterNum, originalDataset)
}
# ************************************************
# genreKmeansClustering() :
#
# Applies k-means clustering on all genre subsets of the clustering dataset.
#
# INPUT: dataframe - dataset - input dataframe
# vector - genre_list - list of genres
# dataframe - original_dataset - original complete dataframe
#
# ************************************************
# Plots cluster diagrams for every genre in "genres" list
# ************************************************
genreKmeansClustering <- function(dataset, genre_list, original_dataset){
for (genre in genre_list){
genre_cluster_predictors <- splitDataBy(dataset, genre)
clustering_predictors <- genre_cluster_predictors[names(genre_cluster_predictors)]
#not including YearofRelease makes the clustering less distinct
clustering_predictors <- subset(clustering_predictors, select = -c(7:44, YearofRelease)) #with franchise but without all encoded columns, YearofRelease and Demographic Cols
numKmeansClusters <- determineClusterNum(clustering_predictors)
#Plots a graph and summary for each genre
applyKmeans_printPlotAndProfiles(clustering_predictors, numKmeansClusters, original_dataset, genre)
}
}
# ************************************************
# genreHierarchicalClustering() :
#
# Applies hierarchical clustering on all genre subsets of the clustering dataset.
#
# INPUT: dataframe- dataset - input dataframe
# list - genre_list - list of genres
# list - cluster_list - list of optimal number of clusters derived from dendrograms
# dataframe - original_dataset - original complete dataframe
# string - xAxis - column to plot on x axis of plot
# string - yAxis - column to plot on y axis of plot
#
# ************************************************
# Plots cluster diagrams for every genre in "genres" list
# ************************************************
genreHierarchicalClustering <- function(dataset, genre_list, cluster_list,
original_dataset,
xAxis="NASales", yAxis="JPSales"){
i<-1
for (genre in genre_list){
genre_cluster_predictors <- splitDataBy(dataset, genre)
clustering_predictors <- genre_cluster_predictors[names(genre_cluster_predictors)]
#not including YearofRelease makes the clustering less distinct
clustering_predictors <- subset(clustering_predictors, select = -c(7:44, YearofRelease)) #with franchise but without all encoded columns, YearofRelease and Demographic Cols
numOfClusters <- cluster_list[i]
#Plots a graph and summary for each genre
applyHierarchical_printPlotAndProfiles(clustering_predictors, numOfClusters,
original_dataset, genre, xAxis, yAxis)
i<-i+1
}
}
# ************************************************
# genreDendrogram() :
#
# Applies hierarchical clustering on all genre subsets of the clustering dataset.
#
# INPUT: dataframe- dataset - input dataframe
# list - genre_list - list of genres
#
# ************************************************
# Plots cluster diagrams for every genre in "genres" list
# ************************************************
genreDendrogram <- function(dataset, genre_list){
for (genre in genre_list){
genre_cluster_predictors <- splitDataBy(dataset, genre)
clustering_predictors <- genre_cluster_predictors[names(genre_cluster_predictors)]
#not including YearofRelease makes the clustering less distinct
clustering_predictors <- subset(clustering_predictors, select = -c(7:44, YearofRelease)) #with franchise but without all encoded columns, YearofRelease and Demographic Cols
numKmeansClusters <- determineClusterNum(clustering_predictors)
#plot dendrogram
result <- hcut(clustering_predictors, k=numKmeansClusters, hc_method = "complete")
p<-factoextra::fviz_dend(result, show_labels = TRUE) +
labs(title=paste("Genre:", genre))
print(p)
}
}
# ******************************************************************************
# modify_dataset()
# Clone the dataset 'main_df' with changes shuffle,
# remove_char_columns, remove_col, dict_rename_col
#
# INPUT: df - main_df - that one ones to modify
# boolean - shuffle - shuffling dataset
# boolean - remove_char_columns - removing columns which are characters
# vector - dict_rename_col - columns that should be renamed
# vector - remove_col - columns that have to be removed
# ******************************************************************************
modify_dataset<-function(main_df, shuffle=FALSE, remove_char_columns=FALSE, remove_col=c(), dict_rename_col=NA){
if (shuffle == TRUE){
main_df <- main_df[sample(1:nrow(main_df)),]
}
if (length(remove_col) > 0){
main_df <- main_df %>% select(-one_of(remove_col))
}
if (remove_char_columns==TRUE){
main_df <- main_df[, sapply(main_df, class) != 'character']
}
if (!is.na(dict_rename_col)){
main_df <- alterDataframeNames(main_df, dict_rename_col )
}
return (main_df)
}
# ************************************************
# character_to_class()
# Alter a column of a dataframe from character to
# numerical classes based on uniqueness of the value
#
# INPUT: data frame - df - original dataframe
# data frame - field - column name
#
# OUTPUT : data frame - a new column with classes
# ************************************************
character_to_class <- function(df, field) {
unique_dict <- unique(games[,field])
print(unique_dict)
new_column <- as.numeric(apply(df[field], 2, function(x) match(x, unique_dict)))
return(list(append_column = new_column, dict = unique_dict))
}
# ************************************************
# most_frequent_games()
# calculating X most frequent games in the dataset
#
# INPUT : data frame - df
# ************************************************
most_frequent_games <- function(df,how_many){
df <- df %>% select('keywords' = 1)
most5FreqGames <- tail(names(sort(table(df$keywords))), how_many)
return (most5FreqGames)
}
# ************************************************
# NEURAL NETWORKS
# ************************************************
# ************************************************
# NN_regression_data() :
#
# create train and test datasets from the parent set
#
# INPUT: data frame - dataset - complete data set
#
# OUTPUT : list("train", "test") - contains train and test datasets
#
# ************************************************
NN_regression_data <- function(games_df){
shuffled_games_nn <- games_df[sample(1:nrow(games_df)), ]
train_bound_nn <- round(nrow(shuffled_games_nn)*(TRAINING_SPLIT))
train_set <- shuffled_games_nn[1:train_bound_nn, ]
test_set <- shuffled_games_nn[-(1:train_bound_nn), ]
return(list("train" = train_set, "test" = test_set))
}
# ************************************************
# NN_features_labels() :
#
# creates feature and labels tags for data
#
# INPUT: data frame - dataset - either the test or the train dataset
#
# OUTPUT : list("features", "labels") - features is all values to train/predict a model. labels are the sales numbers.
#
# ************************************************
NN_features_labels <- function(data_set){
data_features <- data_set %>% select(-GlobalSales)
data_labels <- data_set %>% select(GlobalSales)
return(list("features" = data_features, "labels" = data_labels))
}
# ************************************************
# NN_value_split_data() :
#
# Splits dataset into high and low selling games, also splits into test and train set
#
# INPUT: data frame - dataset - full dataset
#
# OUTPUT : list("low_train", "low_test", "high_train", "high_test") - features is all values to train/predict a model. labels are the sales numbers.
#
# ************************************************
NN_value_split_data <- function(data_set){
low_value_data <- subset(data_set, GlobalSales <= 1)
high_value_data <- subset(data_set, GlobalSales > 2)
low_train_data <- NN_features_labels(NN_regression_data(low_value_data)$train)
low_test_data <- NN_features_labels(NN_regression_data(low_value_data)$test)
high_train_data <- NN_features_labels(NN_regression_data(high_value_data)$train)
high_test_data <- NN_features_labels(NN_regression_data(high_value_data)$test)
return(list("low_train" = low_train_data, "low_test" = low_test_data, "high_train" = high_train_data, "high_test" = high_test_data))
}
# ************************************************
# NN_train_network() :
#
# creates, compiles and trains neural network for regression
#
# INPUT:
# - data frame - train features dataset - all columns needing to train the NN
# - data frame or vector - labels for training data - GlobalSales for the training set
#
# OUTPUT : keras model - trained model - model used during training, can be used to predict values
#
# ************************************************
# Model Creation and Training
# Uses library(keras)
# https://cran.r-project.org/package=keras
# ************************************************
NN_train_network <- function(train_features, train_labels){
sales_model <- keras_model_sequential(input_shape = c(13)) %>%
layer_dense(64, activation = 'relu') %>%
layer_dropout(0.2) %>%
layer_dense(128, activation = 'relu') %>%
layer_dropout(0.2) %>%
layer_dense(128, activation = 'relu') %>%
layer_dropout(0.2) %>%
layer_dense(64, activation = 'relu') %>%
layer_dense(1)
x <- tf$ones(shape(1,13))
y <- sales_model(x)
sales_model %>% compile(
optimizer = optimizer_adam(learning_rate = 0.01),
loss = loss_mean_squared_error(),
metrics = c(metric_root_mean_squared_error())
)
summary(sales_model)
history <- sales_model %>% fit(
as.matrix(train_features),
as.matrix(train_labels),
validation_split = VALIDATION_SPLIT,
epochs = 200,
verbose = 2
)
plot(history)
return(list(history= history, sales_model= sales_model))
}
# ************************************************
# Time Series
# ************************************************
# ************************************************
# createTimeSeries() :
#
# creates a timeseries from the dataset provided
#
# INPUT: data frame - dataset - input data
#
# OUTPUT : time series
# ************************************************
createTimeSeries <- function(dataset, genre) {
TimeSeriesGenre = subset(dataset, dataset$Genre == genre)[, c("ReleaseDate", "GlobalSales")]
TimeSeriesGenre$ReleaseDate <- as.Date(TimeSeriesGenre$ReleaseDate, "%B %d, %Y")
distinctDatedTimeSeries <- distinct(TimeSeriesGenre, ReleaseDate, .keep_all = TRUE)
filteredTimeSeries <- distinctDatedTimeSeries[distinctDatedTimeSeries$GlobalSales < 0.5, ]
filteredTimeSeries <- filteredTimeSeries[!is.na(filteredTimeSeries$ReleaseDate),]
rownames(filteredTimeSeries) <- filteredTimeSeries$ReleaseDate
filteredTimeSeries <- filteredTimeSeries[with(filteredTimeSeries, order(ReleaseDate)),]
return (subset(filteredTimeSeries, select = -c(ReleaseDate)))
}
# ************************************************
# plotTimeSeriesForGenre() :
#
# creates a timeseries from the dataset provided
#
# INPUT: data frame - dataset - input data
# string - genre - genre of games to plot as timeseries
# Prints plots of timeseries for a genre
# ************************************************
plotTimeSeriesForGenre <- function(dataset, genre) {
timeSeries <- createTimeSeries(dataset, genre)
finalTimeSeries <- as.timeSeries(timeSeries)
plot(finalTimeSeries, at="chic", plot.type="s", cex.axis=0.75)
}
# ************************************************
# decomposeTimeSeries() :
#
# plot decomposed time series: seasonal and trend graphs
#
# INPUT: time series - timeSeries - timeSeries of games in a genre
# string - genre - genre of games in timeseries
# Prints plots of seasonal and trend graphs for timeseries for a genre
# ************************************************
plotDecomposedTimeSeries <- function(timeSeries, genre) {
tsGlobalSales = ts(timeSeries, frequency = 365/12) #12 monthly / 4 seasonal
decomposeGlobalSales = decompose(tsGlobalSales, "multiplicative")
plot(decomposeGlobalSales$trend, main = paste("Global Sales trend for", genre))
plot(decomposeGlobalSales$seasonal, main = paste("Global Sales seasonal trend for", genre))
}
# ************************************************
# DECISION TREES #
# ************************************************
# ************************************************
# DT_data() :
#
# Creates train and test datasets for decision trees
#
# INPUT: data frame - dataset - complete dataset
#
#
# OUTPUT : list("train", "test") - train and test data frames
#
# ************************************************
DT_data <- function(data_set){
train_data <- data_set %>% select(-c(NASales, EUSales, JPSales, OtherSales, Name, Publisher, Developer, ReleaseDate, CriticCount, UserCount, CriticScore, UserScore))
# filter out games that have over 20 million sales
train_data <- subset(train_data, GlobalSales < 20)
train_data <- as.data.frame(train_data)
train_data <- na.omit(train_data)
tree_shuffled_games_nn <- train_data[sample(1:nrow(train_data)), ]
tree_shuffled_games_nn_training_boundary <- round(nrow(tree_shuffled_games_nn)*(TRAINING_SPLIT))
tree_shuffled_games_nn_train_set_nn <- tree_shuffled_games_nn[1:tree_shuffled_games_nn_training_boundary, ]
tree_shuffled_games_nn_test_set_nn <- tree_shuffled_games_nn[-(1:tree_shuffled_games_nn_training_boundary), ]
return(list("train" = tree_shuffled_games_nn_train_set_nn, "test" = tree_shuffled_games_nn_test_set_nn))
}
# ************************************************
# DT_log_data() :
#
# Creates train and test datasets for decision trees for values of log(GlobalSales)
#
# INPUT: data frame - dataset - complete dataset
#
#
# OUTPUT : list("train", "test") - train and test data frames
#
# ************************************************
DT_log_data <- function(data_set){
train_data <- data_set %>% select(-c(NASales, EUSales, JPSales, OtherSales))
# filter out games that have over 20 million sales
train_data <- subset(train_data, GlobalSales < 20)
train_data$log_sales <- log10(train_data$GlobalSales)
train_data <- train_data %>% select(-c(GlobalSales))
train_data <- as.data.frame(train_data)
train_data <- na.omit(train_data)
tree_shuffled_games_nn <- train_data[sample(1:nrow(train_data)), ]
tree_shuffled_games_nn_training_boundary <- round(nrow(tree_shuffled_games_nn)*(TRAINING_SPLIT))
tree_shuffled_games_nn_train_set_nn <- tree_shuffled_games_nn[1:tree_shuffled_games_nn_training_boundary, ]
tree_shuffled_games_nn_test_set_nn <- tree_shuffled_games_nn[-(1:tree_shuffled_games_nn_training_boundary), ]
return(list("train" = tree_shuffled_games_nn_train_set_nn, "test" = tree_shuffled_games_nn_test_set_nn))
}
